home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / ilisp / ilisp-xfr.el.z / ilisp-xfr.el
Encoding:
Text File  |  1998-05-21  |  4.9 KB  |  150 lines
  1. ;;; -*- Mode: Emacs-Lisp -*-
  2.  
  3. ;;; ilisp-xfr.el --
  4.  
  5. ;;; This file is part of ILISP.
  6. ;;; Version: 5.8
  7. ;;;
  8. ;;; Copyright (C) 1990, 1991, 1992, 1993 Chris McConnell
  9. ;;;               1993, 1994 Ivan Vasquez
  10. ;;;               1994, 1995, 1996 Marco Antoniotti and Rick Busdiecker
  11. ;;;               1996 Marco Antoniotti and Rick Campbell
  12. ;;;
  13. ;;; Other authors' names for which this Copyright notice also holds
  14. ;;; may appear later in this file.
  15. ;;;
  16. ;;; Send mail to 'ilisp-request@naggum.no' to be included in the
  17. ;;; ILISP mailing list. 'ilisp@naggum.no' is the general ILISP
  18. ;;; mailing list were bugs and improvements are discussed.
  19. ;;;
  20. ;;; ILISP is freely redistributable under the terms found in the file
  21. ;;; COPYING.
  22.  
  23.  
  24.  
  25. ;;;
  26. ;;; ILISP transfer commands Lisp <-> Emacs
  27. ;;;
  28.  
  29.  
  30. ;; It's too bad that this function copies so much code from comint-send-input.
  31. ;; It ought to be a wrapper around it, instead.
  32.  
  33. (defun return-ilisp ()
  34.   "Grab the current expression with comint-get-old-input.  If we have
  35. a complete sexp, send it.  Otherwise, indent appropriately."
  36.   (interactive)
  37.   (let ((proc (get-buffer-process (current-buffer))))
  38.     (if (not proc) (error "Current buffer has no process")
  39.       (let* ((pmark (process-mark proc))
  40.          (input (ilisp-get-old-input)))
  41.     (if input
  42.         (progn 
  43.           (if (>= (point) pmark)
  44.           (goto-char (point-max))
  45.         (goto-char pmark)
  46.         (insert input))
  47.           (if (not ilisp-no-newline) (insert ?\n))
  48.           (if (and (funcall comint-input-filter input)
  49.                (or (ring-empty-p (ilisp-get-input-ring))
  50.                (not (string= (ring-ref (ilisp-get-input-ring) 0)
  51.                      input))))
  52.           (ilisp-ring-insert (ilisp-get-input-ring) input))
  53.           (funcall comint-input-sentinel input)
  54.           ;; Ugh, comint changing under my feet....
  55.           ;; Note: This used to be
  56.           ;;        (eq ilisp-emacs-version-id 'gnu-19)
  57.           ;;       25/11/94 Marco Antoniotti
  58.           (if (eq +ilisp-emacs-version-id+ 'fsf-19)
  59.           (setq comint-input-ring-index nil))
  60.           ;; Nuke symbol table
  61.           (setq ilisp-original nil)
  62.           (funcall comint-input-sender proc input)
  63.           (set-marker (process-mark proc) (point))
  64.           (set-marker comint-last-input-end (point))
  65.           (goto-char (point-max)))
  66.       (if (= pmark (point-max)) 
  67.           (let ((comint-send-newline t))
  68.         (if (not ilisp-no-newline) (insert ?\n))
  69.         (set-marker (process-mark proc) (point))
  70.         (funcall comint-input-sender proc ""))
  71.         (insert ?\n)
  72.         (save-restriction
  73.           (narrow-to-region pmark (point-max))
  74.           (funcall indent-line-function))))))))
  75.  
  76. ;;;%%Keyboard mode
  77. (defun raw-keys-ilisp ()
  78.   "Start using raw keyboard mode to send each character typed to the
  79. inferior LISP until a key bound to interactive-keys-ilisp is
  80. encountered.  See also io-bridge-ilisp." 
  81.   (interactive)
  82.   (if (not ilisp-raw-map)
  83.       (let ((map (make-keymap)))
  84.     (fillarray map 'ilisp-send-char)
  85.     (if (string-match "Lucid" emacs-version)
  86.         ;; not necessary, but friendlier.
  87.          (progn
  88.            (setq ilisp-completion-map (make-keymap))
  89. ;;          (set-keymap-name ilisp-completion-map 'ilisp-completion-map)
  90. ;;           (set-keymap-parent ilisp-completion-map lisp-mode-map)
  91.           ))
  92.     (define-key map "\C-g" 'interactive-keys-ilisp)
  93.     (setq ilisp-raw-map map)))
  94.   (use-local-map ilisp-raw-map)
  95.   (message ilisp-raw-message))
  96.  
  97. ;;;
  98. (defun interactive-keys-ilisp ()
  99.   "Go back to interactive keyboard interactions in the inferior LISP."
  100.   (interactive)
  101.   (use-local-map ilisp-use-map)
  102.   (message "Interactive keyboard mode"))
  103.  
  104. ;;;
  105. (defun ilisp-send-char ()
  106.   "Send the last typed character to the current inferior LISP echoing
  107. if ilisp-raw-echo is T."
  108.   (interactive)
  109.   (if (ilisp-value 'ilisp-raw-echo t)
  110.       (progn
  111.     (goto-char (point-max))
  112.     (insert last-input-char)
  113.     (set-marker (process-mark (ilisp-process)) (point))
  114.     (set-marker comint-last-input-end (point))))
  115.   (process-send-string (ilisp-process) 
  116.                (make-string 1 last-input-char))
  117.   (message ilisp-raw-message))
  118.  
  119. ;;;
  120. (defun ilisp-raw-handler (process output)
  121.   "Turn on raw keyboard mode."
  122.   (raw-keys-ilisp))
  123. (defun ilisp-interactive-handler (process output)
  124.   "Turn on interactive keyboard mode."
  125.   (interactive-keys-ilisp))
  126.  
  127. ;;;
  128. (defun io-bridge-ilisp ()
  129.   "Set up so that the inferior LISP can turn on EMACS raw mode by
  130. sending ^[1^] and turn it off by sending ^[0^]."
  131.   (interactive)
  132.   (require 'bridge)
  133.   (install-bridge)
  134.   (setq bridge-handlers (cons '("1" . ilisp-raw-handler)
  135.                   (cons '("0" . ilisp-interactive-handler)
  136.                     bridge-handlers))))
  137.  
  138. ;;;%%Debugger interface
  139. (defun delete-char-or-pop-ilisp (arg &optional killflag)
  140.   "Delete ARG characters, or pop break level if at end of buffer.  
  141. Optional second arg KILLFLAG non-nil means kill instead (save in kill ring).
  142. Interactively, ARG is the prefix arg, and KILLFLAG is set if
  143. ARG was explicitly specified."
  144.   (interactive "p")
  145.   (if (eobp)
  146.       (progn
  147.     (message "Pop LISP one level")
  148.     (comint-simple-send (ilisp-process) (ilisp-value 'comint-fix-error)))
  149.       (call-interactively 'delete-char (list arg killflag))))
  150.